home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Oberon⁄F™ 1.1 / Obx / Mod / MMerge (.txt) < prev    next >
Encoding:
Oberon Document  |  1996-01-05  |  6.1 KB  |  156 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. MODULE ObxMMerge;
  19. (* note that as in the other sample programs, no error handling is performed *)
  20.     IMPORT Files, Dialog, Views, TextModels, TextViews, TextControllers;
  21.     CONST tab = 09X;
  22.     TYPE
  23.         Field = POINTER TO RECORD
  24.             prev: Field;                            (* field list is sorted in reverse order *)
  25.             name: ARRAY 24 OF CHAR;    (* name of placeholder *)
  26.             tmplFrom, tmplTo: LONGINT;    (* character range used by placeholder in template *)
  27.             index: INTEGER;    (* column index of this field *)
  28.             dataFrom, dataTo: LONGINT    (* character range used by actual data in database *)
  29.         END;
  30.     PROCEDURE TmplFields (t: TextModels.Model): Field;
  31.     (* returns a list of placeholder fields, in reverse order *)
  32.     (* each field defines a text range and name of a placeholder *)
  33.     (* the placeholder has the form "...<NameOfPlaceholder>..." *)
  34.         VAR l, f: Field; r: TextModels.Reader; ch: CHAR; i: INTEGER;
  35.     BEGIN
  36.         l := NIL; r := t.NewReader(NIL); r.SetPos(0); r.ReadChar(ch);
  37.         WHILE ~r.eot DO
  38.             IF ch = "<" THEN
  39.                 NEW(f); f.tmplFrom := r.Pos() - 1;
  40.                 r.ReadChar(ch); i := 0;
  41.                 WHILE ch # ">" DO
  42.                     f.name[i] := ch; INC(i);
  43.                     r.ReadChar(ch)
  44.                 END;
  45.                 f.name[i] := 0X; f.tmplTo := r.Pos();
  46.                 f.dataFrom := -1; f.dataTo := -1;
  47.                 f.prev := l; l := f
  48.             END;
  49.             r.ReadChar(ch)
  50.         END;
  51.         RETURN l
  52.     END TmplFields;
  53.     PROCEDURE ThisDatabase (): TextModels.Model;
  54.         VAR loc: Files.Locator; name: Files.Name; file: Files.File; v: Views.View;
  55.             t: TextModels.Model;
  56.     BEGIN
  57.         t := NIL;
  58.         Dialog.GetIntSpec("", loc, name);
  59.         IF loc # NIL THEN
  60.             v := Views.OldView(loc, name);
  61.             IF (v # NIL) & (v IS TextViews.View) THEN
  62.                 t := v(TextViews.View).ThisModel()
  63.             END
  64.         END;
  65.         RETURN t
  66.     END ThisDatabase;
  67.     PROCEDURE MergeFields (f: Field; t: TextModels.Model);
  68.     (* determine every template field's index in the data text's row of fields *)
  69.         VAR r: TextModels.Reader; index, i: INTEGER; ch: CHAR;
  70.     BEGIN
  71.         r := t.NewReader(NIL);
  72.         WHILE f # NIL DO    (* iterate over all fields in the template *)
  73.             f.index := -1;
  74.             r.SetPos(0); index := 0; ch := tab;
  75.             WHILE (ch = tab) & (f.index = -1) DO    (* compare names of the fields *)
  76.                 REPEAT r.ReadChar(ch) UNTIL ch >= " ";
  77.                 i := 0; WHILE ch = f.name[i] DO r.ReadChar(ch); INC(i) END;
  78.                 IF (ch < " ") & (f.name[i] = 0X) THEN    (* names match *)
  79.                     f.index := index
  80.                 ELSE    (* no match; proceed to next data field *)
  81.                     WHILE ch >= " " DO r.ReadChar(ch) END
  82.                 END;
  83.                 INC(index)
  84.             END;
  85.             f := f.prev
  86.         END
  87.     END MergeFields;
  88.     PROCEDURE ReadTuple (f: Field; r: TextModels.Reader);
  89.     (* read tuple in data, and assign ranges to corresponding fields *)
  90.         VAR index: INTEGER; from, to: LONGINT; ch: CHAR; g: Field;
  91.     BEGIN
  92.         index := 0; ch := tab;
  93.         WHILE ch = tab DO
  94.             REPEAT r.ReadChar(ch) UNTIL (ch = 0X) OR (ch >= " ");
  95.             from := r.Pos() - 1;
  96.             WHILE ch >= " " DO r.ReadChar(ch) END;
  97.             to := r.Pos(); IF ~r.eot THEN DEC(to) END;
  98.             g := f;
  99.             WHILE g # NIL DO
  100.                 IF g.index = index THEN g.dataFrom := from; g.dataTo := to END;
  101.                 g := g.prev
  102.             END;
  103.             INC(index)
  104.         END
  105.     END ReadTuple;
  106.     PROCEDURE AppendInstance (f: Field; data, tmpl, out: TextModels.Model);
  107.         VAR start, from: LONGINT; r: TextModels.Reader; attr: TextModels.Attributes;
  108.     BEGIN
  109.         start := out.Length();
  110.         r := out.NewReader(NIL);
  111.         out.CopyFrom(start, tmpl, 0, tmpl.Length());    (* append new copy of template *)
  112.         WHILE f # NIL DO    (* substitute placeholders, from end to beginning of template *)
  113.             from := start + f.tmplFrom;
  114.             r.SetPos(from); r.ReadRun(attr);    (* save attributes *)
  115.             out.Delete(from, from + f.tmplTo - f.tmplFrom);    (* delete placeholder *)
  116.             out.CopyFrom(from, data, f.dataFrom, f.dataTo);    (* insert actual data *)
  117.             out.SetAttr(from, from + f.dataTo - f.dataFrom, attr);    (* set attributes *)
  118.             f := f.prev
  119.         END
  120.     END AppendInstance;
  121.     PROCEDURE Merge*;
  122.         VAR c: TextControllers.Controller; tmpl, data, out: TextModels.Model;
  123.             tmplFields: Field; r: TextModels.Reader; v: TextViews.View;
  124.     BEGIN
  125.         c := TextControllers.Focus();
  126.         IF c # NIL THEN
  127.             tmpl := c.text;    (* text template used for mail merge *)
  128.             tmplFields := TmplFields(tmpl);    (* determine fields in template *)
  129.             data := ThisDatabase();    (* get text database for mail merge *)
  130.             IF data # NIL THEN
  131.                 MergeFields(tmplFields, data);    (* determine every template field's column in database *)
  132.                 out := TextModels.dir.New();    (* create output text *)
  133.                 r := data.NewReader(NIL); r.SetPos(0);
  134.                 ReadTuple(tmplFields, r);    (* skip meta data *)
  135.                 REPEAT
  136.                     ReadTuple(tmplFields, r);    (* read next data row *)
  137.                     AppendInstance(tmplFields, data, tmpl, out)    (* append new instance of template *)
  138.                 UNTIL r.eot;
  139.                 v := TextViews.dir.New(out);
  140.                 Views.OpenView(v)    (* open text view in window *)
  141.             END
  142.         END
  143.     END Merge;
  144. END ObxMMerge.
  145. TextControllers.StdCtrlDesc
  146. TextControllers.ControllerDesc
  147. Containers.ControllerDesc
  148. Controllers.ControllerDesc
  149. TextRulers.StdRulerDesc
  150. TextRulers.RulerDesc
  151. TextRulers.StdStyleDesc
  152. TextRulers.StyleDesc
  153. TextRulers.AttributesDesc
  154. Helvetica
  155. Documents.ControllerDesc
  156.